-- Haskore Live!
--
-- David Siegel <djsiegel@seas.upenn.edu>
-- Jonathan Coveney <jcoveney@wharton.upenn.edu>
--
-- Interaction.hs
--

-- | Module 'Interaction' contains our asynchronous key event listener for
-- creating live, improvised Performances on top of other Performances while
-- they are being played.
module Interaction ( improvLoop
                   , runTests
                   ) where

import System.IO
import Test.HUnit
import System.Exit
import Control.Monad (forever)
import qualified Data.Time.Clock as Clock
import Control.Concurrent ( MVar
                          , newMVar, readMVar, takeMVar, putMVar
                          , threadDelay, threadWaitRead, killThread
                          , forkOS
                          )

import Basics (Music)
import qualified Keys
import qualified Performer
import PerformerConfig (performer)
import qualified HaskoreUtil as Haskore
import Performance (Performance, Event, eTime)

-- | 'EventData' contains all state associated with a key event: the Music
-- generated by that key, and the relative time of the keypress.
type EventData = (Music, Clock.NominalDiffTime)

-- | 'InputData' represents a stream of input events ('EventData'). We use an
-- MVar to share an InputData between the asynchronous event listener and the
-- synchronous driver thread.
type InputData = MVar ([EventData], Clock.UTCTime)

-- | Given a list of Performances, plays back all Performances and allows the
-- user to improvise a new Performance on top of them.  Returns the improvised
-- Performance (may be empty; only contains the Music corresponding to user key
-- presses, not the other Performances).
improvLoop :: [Performance] -> IO Performance
improvLoop ps = do
    -- Change buffering settings to ensure immediate feedback for key events.
    hSetEcho stdin False
    hSetBuffering stdout NoBuffering
    hSetBuffering stdin NoBuffering

    -- Set up initial state and fork key event listener.
    t0         <- Clock.getCurrentTime
    inputD     <- newMVar ([], t0)
    listenerId <- forkOS $ forever $ keyListener inputD

    -- Begin playback of Performances. This will block until the Performances
    -- have been completely played.
    Performer.perform performer $ Haskore.mergePerformances ps

    -- Get event data recorded by the event listener and build the new
    -- Performance from them.
    (events, time) <- readMVar inputD
    let improv = Haskore.mergePerformances $ map mkPerformance events

    -- Kill the listener thread and restore buffering to defaults.
    killThread listenerId
    hSetEcho stdin True
    hSetBuffering stdin LineBuffering
    hSetBuffering stdout LineBuffering

    return improv

-- | Key event listener main event loop. Each iteration waits until a char is
-- available on stdin, at which point the char is read, converted to Music, and
-- added to the EventData queue in InputData.
keyListener :: InputData -> IO ()
keyListener ind = do
    threadWaitRead 0
    c            <- getChar
    t            <- Clock.getCurrentTime
    (events, t0) <- takeMVar ind
    
    -- Create the EventData, recording music and relative timestamp. Add the
    -- EventData to the shared event queue.
    let event = (Keys.musicForKey c, Clock.diffUTCTime t t0)
    putMVar ind (event : events, t0)

    -- Play the music for this key back for the user.
    Keys.playAsync c

-- | Makes a Performance from the Music contained in an EventData.
mkPerformance :: EventData -> Performance
mkPerformance (m, td) =
    map timeadd (Haskore.musicToPerformance m)

    where -- | Makes the Performance timing relative to the entire improv loop.
          timeadd :: Event -> Event
          timeadd e = e { eTime = (eTime e) + seconds td }
          
          speedup = 2.19
          -- | Converts a fine-grained time diff to a relatively coarse-grained
          -- Float seconds value.
          seconds :: Clock.NominalDiffTime -> Float
          seconds td = fromRational (toRational td) / speedup

-- | Runs unit tests.
--
-- We have chosen to test this module manually, as any unit test would require
-- extremely complicated threading to simulate realtime user interaction.
runTests = runTestTT $
    TestList []
